module Graphics.Vty.AlignMiddle (
  alignMiddle,
  By(), byWidth, byHeight, byBoth,
  updateMiddle,
  horizCatMiddle, vertCatMiddle,
) where

import Graphics.Vty
import Data.Bifunctor

-- | `translate`s and `resize`s `Image`s so their middle lines coincide.
-- Example: @horizCat $ alignMiddle byWidth [title, table]@
alignMiddle :: By -> [Image] -> [Image]
alignMiddle by imgs =
  zipWith ($) translates imgs
 where
  translates = map (\img -> alignMiddle' by (imageBounds img) m) imgs
  m = maxImageBounds imgs

newtype By = By ({- inferred -} (Image -> Image, Image -> Image) -> Image -> Image)
byWidth, byHeight, byBoth :: By
[byWidth, byHeight, byBoth] = map By [fst, snd, (\(f1, f2) -> f1 . f2)]

-- | The same as `update` but positions the `Picture` in the middle of `Vty`.
updateMiddle :: Vty -> Picture -> IO ()
updateMiddle vty pic@Picture{..} = do
  displayBounds <- displayBounds $ outputIface vty
  let align = alignMiddle' byBoth (maxImageBounds picLayers) displayBounds
  update vty $ pic { picLayers = map align picLayers }

-- | The same as `horizCat`/`vertCat` but aligns `Images` by their middle line.
(horizCatMiddle, vertCatMiddle) =
  (horizCat . alignMiddle byHeight, vertCat . alignMiddle byWidth)

alignMiddle' (By by) (innerWidth, innerHeight) (outerWidth, outerHeight) =
  by
  $ bimap (resizeWidth outerWidth .) (resizeHeight outerHeight .)
  $ bimap translateX translateY
  $ both (\(innerBound, outerBound) -> (outerBound - innerBound) `div` 2)
  $ ((innerWidth, outerWidth), (innerHeight, outerHeight))

imageBounds image = bimap imageWidth imageHeight (image, image)

maxImageBounds = both maximum . unzip . map imageBounds

both f = bimap f f

